home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / wipeab_1 / form1.frm < prev    next >
Text File  |  1999-08-09  |  6KB  |  185 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fest Einfach
  4.    Caption         =   "WIPE A BANNER OVER A BACKGROUND"
  5.    ClientHeight    =   4575
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6450
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   305
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   430
  17.    StartUpPosition =   3  'Windows-Standard
  18.    Begin VB.CheckBox Check1 
  19.       Caption         =   "Transparent"
  20.       Height          =   255
  21.       Left            =   960
  22.       TabIndex        =   5
  23.       Top             =   0
  24.       Width           =   1335
  25.    End
  26.    Begin VB.CommandButton Command1 
  27.       Cancel          =   -1  'True
  28.       Caption         =   "END"
  29.       Height          =   375
  30.       Left            =   0
  31.       TabIndex        =   1
  32.       Top             =   0
  33.       Width           =   855
  34.    End
  35.    Begin VB.Timer Timer1 
  36.       Interval        =   20
  37.       Left            =   4560
  38.       Top             =   360
  39.    End
  40.    Begin VB.PictureBox OutPic 
  41.       ClipControls    =   0   'False
  42.       Height          =   3015
  43.       Left            =   0
  44.       ScaleHeight     =   197
  45.       ScaleMode       =   3  'Pixel
  46.       ScaleWidth      =   197
  47.       TabIndex        =   0
  48.       Top             =   360
  49.       Width           =   3015
  50.    End
  51.    Begin VB.Label Label4 
  52.       Alignment       =   2  'Zentriert
  53.       AutoSize        =   -1  'True
  54.       Caption         =   "NO OPENGL OR DIRECTX NEEDED !  JUST A FEW BITBLIT"
  55.       ForeColor       =   &H0000FFFF&
  56.       Height          =   390
  57.       Left            =   3120
  58.       TabIndex        =   6
  59.       Top             =   0
  60.       Width           =   3255
  61.       WordWrap        =   -1  'True
  62.    End
  63.    Begin VB.Label Label3 
  64.       BackStyle       =   0  'Transparent
  65.       BorderStyle     =   1  'Fest Einfach
  66.       Caption         =   "Cool routine.. Load a picture and create a hdc.(invisible)..  view it in module.bas"
  67.       Height          =   375
  68.       Left            =   0
  69.       TabIndex        =   4
  70.       Top             =   3840
  71.       Width           =   6375
  72.    End
  73.    Begin VB.Label Label2 
  74.       BackStyle       =   0  'Transparent
  75.       BorderStyle     =   1  'Fest Einfach
  76.       Caption         =   "All you need is: one Picture.box a background.bmp , a logo.bmp to scroll and a timer"
  77.       Height          =   255
  78.       Left            =   0
  79.       TabIndex        =   3
  80.       Top             =   3480
  81.       Width           =   6375
  82.    End
  83.    Begin VB.Label Label1 
  84.       AutoSize        =   -1  'True
  85.       Caption         =   "TOTAL FREEWARE   questions and comments to RINGS@Online.de"
  86.       ForeColor       =   &H000000FF&
  87.       Height          =   195
  88.       Left            =   120
  89.       TabIndex        =   2
  90.       Top             =   4320
  91.       Width           =   4950
  92.    End
  93. End
  94. Attribute VB_Name = "Form1"
  95. Attribute VB_GlobalNameSpace = False
  96. Attribute VB_Creatable = False
  97. Attribute VB_PredeclaredId = True
  98. Attribute VB_Exposed = False
  99. ' Wipe a banner transparently in a picture-Box
  100. ' another INFO for your Proggy
  101. ' based on different routines downloaded from PLANET-SOURCE-CODE.COM
  102. ' There is still more to do
  103. ' This version updated on 8/9/1999
  104. ' No Second-Picture-Box needed !!!
  105. ' coded by Siegfried Rings, RINGS@Online.de
  106. ' FULLY PublicDomain
  107.  
  108. Option Explicit
  109.  
  110. Private Sub Command1_Click()
  111.  End
  112. End Sub
  113.  
  114.  
  115.  
  116. Private Sub Timer1_Timer()
  117.  Dim mode As Long
  118.  If Check1.Value = 1 Then mode = SRCAND
  119.  If Check1.Value = 0 Then mode = SRCCOPY
  120.  
  121.  scrollbanner OutPic, Me, mode
  122. End Sub
  123.  
  124. Sub scrollbanner(OutputPicture As Control, FMe As Form, mode As Long)
  125. Static DoInitialize As Boolean
  126. Static LogoDC As Long     'The sprite bitmap storage area
  127. Static BackDC As Long       'The background bitmap storage
  128. Static TempDC As Long
  129. Static tmpval As Long
  130. Static angle_x, angle_y, speed, i As Integer
  131. Static MyXPointer, MyYPointer As Integer 'Banner moving in the Box
  132.  
  133. Dim bmp As Long
  134. Static BannerW, BannerH As Integer
  135. Dim w1, h1 As Integer
  136.  
  137. If DoInitialize = False Then
  138.  'First time calling , do some init (loading pictures and create's some Hdc
  139.  angle_x = 180 'logo x angle
  140.  angle_y = 60 'logo y angle
  141.  speed = 6    'spin speed
  142.  Call DirectLoadPicture("Banner5.bmp", LogoDC, bmp, BannerW, BannerH, FMe) 'Load Banner-picture and creates LOGODC
  143.  Call DirectLoadPicture("background1.bmp", BackDC, bmp, w1, h1, FMe) 'Load Backgroundpicture and creates BackDC
  144.  OutputPicture.Width = w1
  145.  OutputPicture.Height = h1
  146.  Call DirectLoadPicture("", TempDC, bmp, OutputPicture.Width, OutputPicture.Height, FMe) 'create work area
  147.  DoInitialize = True
  148. End If
  149.  
  150. 'the Logo moves from left to right
  151. MyXPointer = MyXPointer + 2
  152. If MyXPointer > OutputPicture.Width Then MyXPointer = -BannerW / 2
  153. 'And from top to bottom
  154. MyYPointer = MyYPointer + 1
  155. If MyYPointer > OutputPicture.Height Then MyYPointer = -BannerH
  156.  
  157. 'now copy Background in temporary bitmap
  158. tmpval = BitBlt(TempDC, 0, 0, OutputPicture.Width, OutputPicture.Height, BackDC, 0, 0, SRCCOPY) 'copy background to stage area
  159.  
  160.  
  161. 'there is room for more improvment for SIN-Scroller
  162. For i = 1 To BannerW
  163.  'Copy Banner with sin-effect in temporary background
  164.  tmpval = BitBlt(TempDC, Cos(degtorad(angle_x + i)) * (BannerW / 4.25) + MyXPointer, Sin(degtorad(angle_y + i)) * 10 + 2.5 + MyYPointer, 1, BannerH, LogoDC, i, 0, mode)  ' put spinning logo onto stage area
  165. Next i
  166.         
  167. 'Now copy temporary bitmap to output-Picture-Box
  168. tmpval = BitBlt(OutputPicture.hDC, 0, 0, OutputPicture.Width, OutputPicture.Height, TempDC, 0, 0, SRCCOPY) ' copy stage to PictureBox
  169.         
  170.  
  171. 'any calculations follows
  172. angle_x = angle_x + speed * 0.5 ' rotate logo x
  173. angle_y = angle_y + speed * 2 ' rotate logo y
  174.        
  175. If angle_x >= 360 Then  ' have we done a full rotation 360o??
  176.   angle_x = 0  ' Yep, reset angle
  177. End If
  178. If angle_x <= -180 Then  ' have we done a full rotation 360o??
  179.   speed = speed * -1
  180. End If
  181. If angle_y >= 360 Then
  182.    angle_y = 0
  183. End If
  184. End Sub
  185.